Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / pssst.arc / PSSST.PRG < prev next >

Wrap

Text File | 1986-08-15 | 9.5 KB | 291 lines

* PSSST.PRG * * A DBASE II 16BIT COMMAND FILE to set up the psssst system and * allow branching to the major branches of the PSSST system. * * Version 1 * By LTC Denny Hugg * ANGSC/DOS Andrews AFB MD 16 Jul 1985 * * Version 2 * modified by Maj Jim McMurry * ANGSC/DOSC Truax Field, WI 15 Jun 1986 * * Uses the g prefix for global variables * SET TALK OFF SET BELL OFF SET COLON OFF ERASE * --- gflag = 'Y' tells psprompt to put a box around the prompt * which is the predominant mode STORE 'Y' TO gflag * --- create other global variables from info in PSCONFIG.MEM USE PSCONFIG.MEM IF .NOT. model$('ZIO') * --- the delete flag tells psconfig to return here USE PSCONFIG.MEM DELETE USE DO PSCONFIG ENDIF USE PSCONFIG.MEM STORE model TO gmodel STORE TRIM(firstname) TO gfirstname STORE INT((LEN(gfirstname)/2)+.5) TO gflength DO CASE CASE delays = ' ' STORE 50 TO gdelay CASE delays = 'S' STORE 25 TO gdelay CASE delays = 'M' STORE 50 TO gdelay CASE delays = 'L' STORE 75 TO gdelay ENDCASE USE DO PSMENU * --- an empty string for clearing a specific line STORE $(STR(1,81),1,80) TO gclearline STORE ' ' TO gaddstring * --- beginning of light bar menu system * --- Available for separator line when affordable DO WHILE T * --- he's not on initial entry IF gaddstring <> ' ' ERASE STORE 'p S S S t M A S T E R M E N U' TO heading DO PSHEADING ENDIF STORE chr(95)+chr(95) TO ln STORE ln+ln+ln+ln+ln TO ln STORE ln+ln+ln+ln+ln+ln+ln+ln TO ln * --- The Menu Items STORE 'PHONE' TO p1 STORE 'JOB' TO p2 STORE 'PRIORITY' TO p3 STORE 'SUSPENSE' TO p4 STORE 'EXIT' TO p5 * --- places spaces between menu items ... no inverse video. * --- leading space added to force lin to line 23 w/o jumping up. * --- 45 columns available. STORE ' '+p1+' '+p2+' '+p3+' '+p4+' '+p5 TO lin * --- the prompts at right end of line 23 ... 35 columns available STORE ' (Rolodex System)' TO y1 STORE ' (Tracking And Editing System)' TO y2 STORE ' (Management System)' TO y3 STORE ' (Listing To Screen Or Printer)' TO y4 STORE ' (To Operating System)' TO y5 * --- the columns at which the menu items are located STORE '0009162840' TO col STORE 1 TO c STORE '1' TO z STORE '0' TO mcho STORE t TO screen * --- prompt elsewhere on screen if desired @ 21,14 SAY 'Arrows Progress Through Menu ... <Return> To Select' * --- prints separator bar if affordable @ 22,0 SAY gline DO WHILE screen * --- displays menu items followed by current prompt @ 22,79 SAY lin + y&z * --- hi-lites the current menu item @ 23,VAL($(col,c,2)) GET p&z CLEAR GETS SET CONSOLE OFF * --- D and C returned by Z-100 arrow keys * --- K and M returned by Z-150 & IBM arrow keys * --- 4 and 6 used in case not in num-lock mode STORE '0' TO mcho DO WHILE ' '<>mcho .AND. .NOT. mcho$'DCKM46' WAIT TO mcho ENDDO SET CONSOLE ON DO CASE CASE mcho$('CM6') * --- dependant on number of menu items IF c#9 STORE c+2 TO c STORE str(val(z)+1,1) TO z ELSE STORE 1 TO c STORE '1' TO z ENDIF CASE mcho$('KD4') IF c>1 STORE c-2 TO c STORE str(val(z)-1,1) TO z ELSE * --- dependant on number of menu items STORE 9 TO c * --- dependant on number of menu items STORE '5' TO z ENDIF * --- ' ' returned by both return and space bars (unfortunately) CASE mcho = ' ' STORE f TO screen LOOP ENDCASE ENDDO * --- result is the column you're currently at * ----------------------------------------------------------------------* * ---------------------This Unique To PSSST-----------------------------* @ 21, 0 SAY gclearline @ 22, 0 SAY gclearline @ 22,79 SAY gclearline * --- otherwise he's on initial entry and wants to get out IF gaddstring = ' ' .AND. c<>9 * --- he's on initial entry USE PSCONFIG.MEM * --- namestring is a character field, length 6 in PSCONFIG IF namestring = ' ' * --- he's configured multi-user STORE ' ' TO mfilename @ 0, 0 SAY gcuron @ 22,18 SAY 'Type in your last name, please ' GET mfilename READ NOUPDATE @ 0, 0 SAY gcuroff @ 22,0 SAY gclearline STORE TRIM(mfilename) TO mfilename * --- create a standard length filename for the guy IF LEN(mfilename) < 6 STORE '000000' TO msixblnks STORE $(mfilename,1,LEN(mfilename)); + $(msixblnks,1,6-LEN(mfilename)) TO mfilename STORE $(mfilename,1,6) TO gaddstring ELSE STORE $(mfilename,1,6) TO gaddstring ENDIF ELSE * --- he's configured it for single user STORE namestring TO gaddstring ENDIF * --- create global variables for files and indexes * --- pssst uses the current year in the filename, this way when the year * --- changes, you're sent to PSNEWGUY to do some administrative stuff STORE gaddstring + 'SP.0' + $(DATE(),7,2) TO gsusfile STORE gaddstring + 'CM.0' + $(DATE(),7,2) TO gcomplfile STORE gaddstring + 'DD.0' + $(DATE(),7,2) TO gdelfile * --- indexes named differently ... if the same as the dbf, they'll * --- eventually scramble things STORE gaddstring + 'SI' TO gsusindex STORE gaddstring + 'PI' TO gpryindex * --- convert DATE() to YY/MM/DD so indexing will order them STORE VAL($(DATE(),1,2)) TO month STORE VAL($(DATE(),4,2)) TO day STORE VAL($(DATE(),7,2)) TO year STORE STR(year,2) TO gdate IF month > 9 STORE TRIM(gdate) + '/' + STR(month,2) + '/' TO gdate ELSE STORE gdate + '/0' + STR(month,1) + '/' TO gdate ENDIF IF day > 9 STORE gdate + STR(day,2) TO gdate ELSE STORE gdate + '0' + STR(day,1) TO gdate ENDIF * --- check that today's date is later than last date used * --- last:day is a character field, length 8 in PSCONFIG.MEM IF gdate < last:day DO WHILE gdate < last:day STORE gdate TO input STORE 10 TO line ERASE STORE 'You Can Never Go Back ' + gfirstname TO prompt DO PSPROMPT ? gcuron @ 22,19 SAY "You Need To Re-enter Today's Date "; GET input PICTURE '99/99/99' READ @ 0, 0 SAY gcuroff @ 9, 0 SAY gclearline @ 10, 0 SAY gclearline @ 11, 0 SAY gclearline IF input >= last:day STORE input TO gdate ENDIF ENDDO ENDIF REPLACE last:day WITH gdate USE * --- see if the guy already has a file - if not, make one IF .NOT. FILE ("&gsusfile") DO PSNEWGUY.PRG ENDIF ENDIF *------------------------------------------------------------------------* DO CASE CASE c=1 RELEASE ALL EXCEPT g* DO PSPHONE CASE c=3 RELEASE ALL EXCEPT g* DO PSJOBTRK CASE c=5 RELEASE ALL EXCEPT g* DO PSPRIORY CASE c=7 RELEASE ALL EXCEPT g* DO PSSUSPEN CASE c=9 @ 22, 0 SAY gclearline @ 22,79 SAY gclearline * This backup procedure backs up the database sorted in the order * according to the index file. This speeds up future sequential * movements of the record pointer. IF gaddstring <> ' ' STORE ' ' TO select @ 22,20 SAY 'Do You Wish To Back Up Your Data (Y/N) '; GET select PICTURE '!' READ @ 22, 0 SAY gclearline IF select = 'Y' USE PSCONFIG.MEM IF back:drive = ' ' STORE " :" TO drive @ 22,27 SAY "Drive Backup Disk Is On " @ 22,51 GET drive PICTURE "!:" READ @ 22, 0 SAY gclearline ELSE STORE back:drive + ':' TO drive STORE 10 to line STORE 'Insert Your Backup Disk In Drive ' + drive TO prompt DO PSPROMPT STORE 22 TO line STORE 'N' TO gflag STORE '- Strike Any Key To Continue -' TO prompt DO PSPROMPT STORE 'Y' TO gflag SET CONSOLE OFF WAIT SET CONSOLE ON @ 9, 0 SAY gclearline @ 10, 0 SAY gclearline @ 11, 0 SAY gclearline @ 22, 0 SAY gclearline ENDIF @ 22,33 SAY "Backing Up ..." * --- Back it up USE &gsusfile INDEX &gsusindex COPY TO &drive.&gsusfile COPY TO &drive.&gcomplfile COPY TO &drive.&gdelfile USE ENDIF ENDIF USE ERASE @ 0, 0 say gcuron QUIT ENDCASE STORE f TO screen ENDDO * --- end of light bar menu system * --- EOF PSSST.PRG @ 22, 0 SAY gclearline @ 22,79 SAY gclearline * This backup procedure backs up the database sorted in the order * according to the index file. This speeds up future sequential * movements of the record pointer.